home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Appls / dumpbrush.f < prev    next >
Encoding:
FORTH Source  |  1991-04-25  |  1.9 KB  |  89 lines
  1. \ Convert Brush to Image Source Code
  2. \
  3. \ Author Phil Burk
  4. \ Copyright 1990 Phil Burk
  5. \
  6. \ MOD: PLB/MDH 2/6/91 Make dataname from filename, add GET.NAME
  7.  
  8. include? $iff>bitmap jiff:show_iff
  9. decimal
  10. anew TASK-DumpBrush
  11.  
  12. : .WORD  ( n -- , print hex word with leading zeros )
  13.     s->d <# # # # # #> type
  14. ;
  15.  
  16. : NEWLINE  ( -- , emit EOL for new line )
  17.     ?pause EOL emit
  18. ;
  19.  
  20. : GET.NAME ( -- addr count , name of file )
  21.     pad count strip-pathname  \ from fileword
  22. ;
  23.  
  24. : .NAME ( -- )
  25.     get.name type
  26. ;
  27.  
  28. : .NAMEI .name ." -image" ;
  29.  
  30. : PRINT.BITMAP  { bmap | width height #planes plane -- }
  31. \ get info from bitmap
  32.     bmap bitmap>wh -> height -> width
  33.     bmap ..@ bm_depth -> #planes
  34. \
  35. \ print source code for image
  36.     ." image " .namei newline
  37.     width . .namei   ."  s! ig_width" newline
  38.     height . .namei  ."  s! ig_height" newline
  39.     #planes . .namei ."  s! ig_depth" newline
  40. \ check for not word aligned brush
  41.     width 15 and 0>
  42.     IF ." Warning - width not even number of bytes!" newline
  43.     THEN
  44. \
  45. \ Print source code for bit planes
  46.     hex
  47.     ." create "    .name ." -planes   here HEX" newline
  48.     #planes 0
  49.     DO  ." \ Plane " i . newline
  50.         i bmap bmplane[] @ >rel -> plane
  51.         height 0
  52.         DO    \ for each word in row
  53.             3 spaces
  54.             width 16 / 0
  55.             DO    space plane dup w@ .word ."  w,"
  56.                 2+ -> plane
  57.             LOOP newline
  58.         LOOP
  59.         newline
  60.     LOOP
  61.     ." here swap - constant "
  62.     .name ." _size   DECIMAL" newline
  63.     ." \ Copy image data to CHIP RAM before using!" newline
  64.     decimal
  65. ;
  66.  
  67. : $DumpBrush  ( $filename -- )
  68.     $iff>bitmap ?dup
  69.     IF
  70.         dup>r print.bitmap
  71.         r> free.bitmap
  72.     ELSE ." Couldn't read brush!" newline
  73.     THEN
  74. ;
  75.  
  76. : DumpBrush  ( <filename> -- )
  77.     ." \ DumpBrush by Phil Burk 1990" newline
  78.     ." \ Written using JForth Professional" newline
  79.     ." \ Public Domain" newline
  80.     ." \      DUMPBRUSH >outfile brushfilename" newline
  81.     fileword   here pad $move
  82.     $dumpbrush
  83. ;
  84.  
  85. >newline
  86. ." Use LOGTO or Clone this and enter:" cr
  87. ."    DUMPBRUSH >outfile brushfilename" cr
  88.  
  89.